Just Call Me Internet/Just Call Me Internet.iso/prog/atari/m2/cat3src/magic/i/rtd.i

Modula Implementation | 1997-10-26 | 5.1 KB | 154 lines

(*----------------------------------------------------------------------*
 *                                                                      *
 *         MAGIC   Modula's  All purpose  GEM  Interface  Cadre         *
 *                 ÿ         ÿ            ÿ    ÿ          ÿ             *
 *----------------------------------------------------------------------*
 * Version 3.30  02.02.1992     (C)90/91/92 by Peter Hellinger Software *
 *----------------------------------------------------------------------*
 *            Dieses Modul ist urheberrechtlich geschtzt.              *
 *                                                                      *
 * Die Ver”ffentlichung des Quelltextes oder Teilen daraus in schrift-  *
 * licher Form, insbesondere in Zeitschriften, sowie die Verbreitung    *
 * ber Public-Domain-H„ndler bedarf der ausdrcklichen schriftlichen   *
 * Genehmigung des Autors!                                              *
 *                                                                      *
 * Der Autor gibt hiermit die ausdrckliche Erlaubnis, das Modul jeder- *
 * zeit auch im Quelltext weiterzugegeben, sofern dessen Text und ins-  *
 * besondere dieser Urheberrechts-Vermerk nicht ver„ndert wird, und     *
 * durch die Weitergabe kein finanzieller Nutzen entsteht. Der Autor    *
 * beh„lt sich das Recht vor, diese Erlaubnis jederzeit u. ohne Angaben *
 * von Grnden zu widerrufen.                                           *
 *----------------------------------------------------------------------*)

IMPLEMENTATION MODULE RTD;

(*----------------------------------------------------------------------*
 * Int. Vers | Datum    | Name | Žnderung                               *
 *-----------+----------+------+----------------------------------------*
 *  3.00     | 18.01.92 |  Hp  |                                        *
 *-----------+----------+------+----------------------------------------*)



(* IMPLEMENTATION FšR  >>> Megamax-Modula-2 <<< *)
(*                                              *)
(*$R-   Range-Checks                            *)
(*$S-   Stack-Check                             *)
(*                                              *)
(*----------------------------------------------*)






FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
                        Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
                        Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
                        sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET,
                        CastToChar, CastToByte, CastToByteset, CastToInt,
                        CastToCard, CastToBitset, CastToWord, CastToLInt,
                        CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
                        TosVersion, Accessory, Basepage, SysHeader, TosDate;






FROM MagicBIOS  IMPORT  Bconout, Bconstat, Bconin, CON, PRT, AUX;
FROM MagicConvert IMPORT NumToStr;
FROM MagicStrings IMPORT Assign;

CONST   cMaxIndent =    40;

VAR     indent, i:      sCARDINAL;
        device:         sINTEGER;


PROCEDURE write (string: ARRAY OF CHAR);
VAR i: sCARDINAL;
    ch: CHAR;
BEGIN
 FOR i:= 0 TO HIGH(string) DO
  IF string[i] = 0C THEN  RETURN  END;
  ch:= string[i];  Bconout (device, ch);
 END;
END write;

PROCEDURE writeLn;
BEGIN
 Bconout (device, 15C);  Bconout (device, 12C);
END writeLn;

PROCEDURE writeIndent;
VAR i: sCARDINAL;
BEGIN
 FOR i:= 0 TO indent DO  Bconout (device, ' ');  END;
END writeIndent;

PROCEDURE Into (REF procedure: ARRAY OF CHAR);
BEGIN
 writeIndent;  write ("I: ");  write (procedure);  writeLn;
 IF indent < cMaxIndent THEN INC(indent);  END;
END Into;

PROCEDURE Leaving (REF procedure: ARRAY OF CHAR);
BEGIN
 IF indent > 0 THEN DEC(indent); END;
 writeIndent;  write ("L: ");  write (procedure);  writeLn;
END Leaving;

PROCEDURE Message (REF string: ARRAY OF CHAR);
BEGIN
 writeIndent;  write (string);  writeLn;
END Message;

PROCEDURE Write (REF msg, string: ARRAY OF CHAR);
BEGIN
 writeIndent;  write (msg);  write ('  ');  write (string);  writeLn;
END Write;

VAR s: ARRAY [0..32] OF CHAR;

PROCEDURE ShowVar (REF name: ARRAY OF CHAR; VAR value: ARRAY OF LOC);
VAR wert: lCARDINAL;
BEGIN
 writeIndent;
 write (name);
 write(" = ");
 wert:= CastToLCard (value);
 NumToStr(wert, 7, 10, FALSE, s);  write (s);  write ('  ');
 NumToStr(wert, 8, 16, FALSE, s);  write (s);  write ('H ');
 IF HIGH (value) = 0 THEN
  NumToStr (CastToLCard (value[0]), 9, 2, FALSE, s);  write(s);
  IF ( CastToChar(value[0]) >= ' ' ) THEN
   write ("  <");  Bconout (device, CastToChar(value[0])); write ("> ");
  END;
 END;
 writeLn;
END ShowVar;

PROCEDURE SetDevice(dev: DEVICE);
BEGIN
 CASE dev OF
  printer: device:= PRT;|
  rs232:   device:= AUX;|
  console: device:= CON;|
  ELSE     device:= CON;
 END;
END SetDevice;

PROCEDURE WaitKey;
VAR d: LONGCARD;
BEGIN
 (* REPEAT UNTIL Bconstat (device); *)
 d:= Bconin (device);
END WaitKey;

BEGIN
 indent:= 0;
 device:= CON;
END RTD.